%% objpats.erl
%%      Relaxates class-manipulation patterns and expressions into
%%      element, setelement and size BIF-calls.
%% 
%% Copyright (C) 2008, 2009 Gábor Fehér
%%
%% This file is part of ECT.
%% 
%% ECT is free software: you can redistribute it and/or modify
%% it under the terms of the GNU General Public License as published by
%% the Free Software Foundation, either version 3 of the License, or
%% (at your option) any later version.
%% 
%% ECT is distributed in the hope that it will be useful,
%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%% GNU General Public License for more details.
%% 
%% You should have received a copy of the GNU General Public License
%% along with ECT.  If not, see <http://www.gnu.org/licenses/>.
%%
-module(objpats).
-export([relax/6, relax_list/5, split/2, equalities/1, resolve_list/2, extract_boundvars/1]).


-include("objpats.hrl").   % #relaxstate{}, #flatitem{}
-include("common_defs.hrl").


%% Function: relax_list(PatternList, Records, Classes, CxClass, Mode)
%% Purpose: applies relax/6 on a list of patterns.
%% See relax/6 for more explanation.
relax_list([{Pattern, VarName}|Patterns], Records, Classes, CxClass, Mode) when Mode =:= normal orelse Mode =:= shallow ->
    relax(Pattern, VarName, Records, Classes, CxClass, Mode)
    ++relax_list(Patterns, Records, Classes, CxClass, Mode);
relax_list([], _, _, _, Mode) when Mode =:= normal orelse Mode =:= shallow ->
    [].

%% Function: relax(Pattern, VarName, Records, Classes, CxClass, Mode)
%% Purpose:
%%     Relaxes a 'Var = Pattern' AST structure into a list of 
%%     pure value-assingment and pure value testing components. For example:
%%     A = #record{x = X, y = {"hello, world", Y}} is transformed to
%%     X = element(2, A), "hello, world" = element(1, element(3, A)), Y = element(2, element(3, A))
%%     Nesting of such patterns, and class pattern-matches are also allowed.
%%     The resulting patterin items are in #flatitem{} records,
%%     that can converted back to AST by resolve_path.
%%
%% Arguments:
%%      Pattern   the pattern to relax
%%      VarName   the variable name associated with tha pattern
%%      Records   record definitions in the form generated by module records
%%      Classes   list of class definitions [#class{}]
%%      Mode      shallow
%%                   does not recurse into subpatterns of object/record expressions
%%                deep
%%                   recurse until the deepest leaf nodes of the pattern
%% Result: 
%%    [#flatitem{}] where each item of the list can be expanded with resolve_path/3 to
%%    the pure value-assingment/value testing components mentioned in the Purpose section 
%%    of this comment.
relax(Pattern, VarName, Records, Classes, CxClass, Mode) when Mode =:= normal orelse Mode =:= shallow ->
    Line = element(2, Pattern),
    #relaxstate{list = List} =
        relax_pattern(
            Pattern,
            #relaxstate{expr_path = {var, Line, VarName}, list = [],  records = Records, mode = Mode, classes = Classes, cx_class = CxClass}
        ),
    lists:reverse(List).  %% reverse the list of flat items (and not the path lists) to restore the original order of patterns

%% Function: relax_pattern(Item, RelaxState)
%% Purpose: 
%%      collects #flatitems{} of a pattern and maintains neccessary state variables
%%      in a #relaxstate{} record, most importantly
%%      -path is always the path to the current parsing position (see flat.hrl about path)
%%         so if relax_pattern recursively calls itself, then usually an extended path is passed with the call
%%      -list is the list of collected flatitems
%% Arguments:
%%   Item: the pattern (subpattern) to relax
%%   RelaxState::#relaxstate{}: information collected so far, the state record mentioned above
%% Returns:
%%   RelaxState, with all the #flatitem{} records derived from Item added.

% The following clauses process the leaf nodes of the pattern.
%  All of them create a new list item, with the givan path.
relax_pattern({var,_,'_'}, FS) ->
    FS;
relax_pattern(Item = {var,_,_}, FS) -> relax_leaf(Item, FS);
relax_pattern(Item = {atom,_,_}, FS) -> relax_leaf(Item, FS);
relax_pattern(Item = {integer,_,_}, FS) -> relax_leaf(Item, FS);
relax_pattern(Item = {nil,_}, FS) -> relax_leaf(Item, FS);
relax_pattern(Item = {char,_,_}, FS) -> relax_leaf(Item, FS);
relax_pattern(Item = {float,_,_}, FS) -> relax_leaf(Item, FS);
relax_pattern(Item = {string,_,_}, FS) -> relax_leaf(Item, FS);
% The following clauses process the non-leaf nodes of the pattern.
%  They revursively call relax_pattern on the sub-elements of the
%  current pattern, each with path = [sub_element_path_item|current path]
relax_pattern({match,_,L,R}, FS1) ->
    %% match does not affects access path, e.g. in {x, y, {_, A} = {_, B}, z}, 
    %% A and B has the same path
    FS2 = relax_pattern(L, FS1),  % process left
    relax_pattern(R, FS2);       % process right
relax_pattern({cons,Line,H0,T0}, RS = #relaxstate{expr_path = ExprPath}) ->
    #relaxstate{list = List2} = relax_pattern(H0, RS#relaxstate{expr_path = ast:hd(ExprPath, Line)}),
    RS2 = relax_pattern(T0, RS#relaxstate{list = List2, expr_path = ast:tl(ExprPath, Line)}),
    add_item(RS2, #flatitem{type = guard, expr = 
                                {op, Line, 'andalso',
                                    {call, Line, {atom, Line, 'is_list'}, [ExprPath]},
                                    {op, Line, '=/=', ExprPath, {nil, Line}}
                                }
                           });
relax_pattern({tuple,Line,Ps0}, RS = #relaxstate{expr_path = ExprPath}) ->
    %% tuple affects path, but it's handled in flat_pattern_tuple
    %% here we only add an extra flatitem, to check the tuple size
    relax_pattern_tuple(Ps0,
            add_item(RS, #flatitem{type = eq, arg = {integer,Line,length(Ps0)}, expr = ast:size(ExprPath, Line)}),
            1);
relax_pattern({record,Line,Name,Pfs0}, RS = #relaxstate{expr_path = ExprPath, records = Records, classes = Classes}) ->
    Definition = 
    	case class_record_common:get_definition(Classes, Records, Name) of
		notfound ->
			throw({translateError, Line, "No record or class definition found for '"++atom_to_list(Name)++"'"});
		Def -> Def
		end,
    TypeCheck =
    	case Definition of
    	#class{} -> 
			#flatitem{type = eq, arg = {atom,Line,Name}, expr = ast:class_type_expr(Definition, ExprPath, Line)};
		{record, _, _} ->
			#flatitem{type = guard, expr = ast:record_typecheck_guard(Records, Name, ExprPath, Line)}
		end,
    relax_pattern_fields(Pfs0, add_item(RS, TypeCheck), Definition);
relax_pattern(Pattern, _) ->
    Line = element(2, Pattern),
    throw({translateError, Line, "[ect] relaxing this pattern is not implemented"}).

%% Function: relax_leaf(Item, RelaxState)
%% Purpose: helper function for simple cases of flat_pattern
%% Arguments:
%%   Item: a simple pattern, that can not be decomposed into subpatterns (e.g.: integer, atom, string, [], ...)
%%   RelaxState::#relaxstate{}: Item will be added to the list of flatitems, with the current path prefix
%% Returns:
%%   RelaxState with a #flatitem{} corresponding to Item added
relax_leaf(Arg, RS = #relaxstate{expr_path = ExprPath}) ->
    add_item(RS, #flatitem{type = eq, arg = Arg, expr = ExprPath}).

%% Function: relax_pattern_tuple(Patterns, RelaxState, Pos)
%% Purpose: creates #flatitem{} records for elements of a tuple-pattern
%% Arguments:
%%   Patterns: list of subpatterns of the tuple-pattern
%%   RelaxState: state of relaxing at the point where the tuple-pattern is found see head comment of relax_pattern/2
%%   Pos::integer(): have to be 1 when calling from the outside
%%                   It is the position of hd(Patterns) in the original list of tuple patterns
%% Returns:
%%   RelaxState with all the #flatitems{} derived from the patterns of Patterns
relax_pattern_tuple([], FS, _) ->
    FS;
relax_pattern_tuple([Pattern|Ps], FS = #relaxstate{expr_path = ExprPath}, N) ->
    Line = element(2, Pattern),
    #relaxstate{list = L2} =
        relax_pattern(
            Pattern,
            FS#relaxstate{expr_path = ast:element(N, ExprPath, Line)}
        ),
    relax_pattern_tuple(Ps, FS#relaxstate{list = L2}, N+1).

%% Function: relax_pattern_fields(Fields, RelaxState, Definition)
%% Purpose:
%%      Creates #flatitem{} records from a list of patterns corresponding to record/class fields, and puts them into 
%%      RelaxState#relaxstate.list .
%%      The path prefix is #relaxstate.path .
%%      -In shallow mode, does not recurse into subpatterns.
%%      -In deep mode, recurses into subpatterns.
%%      TODO CHECK: deep/shallow stuff in case of nested patterns?
%% Arguments:
%%   Fields: list of subpatterns of the record/class-pattern
%%   RelaxState: state of relaxing at the point where the tuple-pattern is found see head comment of relax_pattern/2
%%   Definition: definition of the record/class, that the record/class pattern corresponds to
%% Returns:
%%   RelaxState with all the #flatitems{} derived from the subpatterns of Fields.
relax_pattern_fields([{record_field,Line,Field,Pattern}|Pfs], FS = #relaxstate{expr_path = ExprPath, mode = shallow, cx_class = CxClass}, Definition) ->
    {atom,_,FieldName} = Field,
	#relaxstate{list = List2} = 
			relax_leaf(
				Pattern,
				FS#relaxstate{expr_path = class_record_common:field_accessor(Definition, FieldName, ExprPath, CxClass, Line)}
			),
	relax_pattern_fields(Pfs, FS#relaxstate{list = List2}, Definition);
relax_pattern_fields([{record_field,Line,Field,Pattern}|Pfs], FS = #relaxstate{expr_path = ExprPath, cx_class = CxClass}, Definition) ->
    %% Field, Pattern: expr
    {atom,_,FieldName} = Field,
    #relaxstate{list = L2} = 
			relax_pattern(
				Pattern,
				FS#relaxstate{expr_path = class_record_common:field_accessor(Definition, FieldName, ExprPath, CxClass, Line)}
        	),
	relax_pattern_fields(Pfs, FS#relaxstate{list = L2}, Definition);
relax_pattern_fields([], RS, _) -> RS.



%% Function: add_item(RelaxState, Item)
%% Purpose: adds a new #flatitem{} record into the list in RelaxState
%% Arguments:
%%   RelaxState::#relaxstate{}
%%   Item::#flatitiem{}
%% Returns:
%%   RelaxState with Item added into the list of flatitems
add_item(RS, Item) ->
    RS#relaxstate{list = [Item|RS#relaxstate.list]}.



%%-----------

%% Function: resolve_path(FlatItem, Line, Mode)
%% Puspose: 
%%   converts a #flatitem{} either into an Erlang guard or into an Erlang match expression
%% Arguments:
%%   FlatItem::#flatitem{} - the flatitem to convert
%%   Mode: either match or guard, specifies the form of the output
%% Returns:
%%   the abstract syntax tree (AST) of the resulting guard/match expression
resolve_path(FI = #flatitem{expr = Expr}, Mode) when Mode =:= match orelse Mode =:= guard ->
    Line = element(2, Expr),
    resolve_path(FI, Line, Mode).
resolve_path(#flatitem{type = eq, arg = Arg, expr = Expr}, Line, match) ->
    {match, Line, Arg, Expr};
resolve_path(#flatitem{type = eq, arg = Arg, expr = Expr}, Line, guard) ->
    {op, Line, '=:=', Arg, Expr};
%no need for this case:
% resolve_path(#flatitem{type = guard, expr = Expr}, Line, match) ->
%     {match, Line, {atom, Line, true}, Expr};
resolve_path(#flatitem{type = guard, expr = Expr}, _, guard) ->
    Expr.


%% Function: resolve_list(Flats, match)
%% Purpose: applies resolve_path/3 on a list of #flatitem{} records
resolve_list([FI|Flats], match) ->
    [resolve_path(FI, match)
    |resolve_list(Flats, match)];
resolve_list([], match) -> [].

%% Function: is_variable(FlatItem, BoundVars)
%% Purpose: determines if a FlatItem is a value assingment to a variable
%%                                   or a value-test of an expression
%% Arguments:
%%   FlatItem::#flatitem{}
%%   BoundVars - list of names of bound variables
%% Returns:
%%   true if FlatItem assigns a new value to an unbound variable
%%   false otherwise
is_variable(#flatitem{arg = {var, _, VarName}}, [VarName|_]) ->
    false;
is_variable(FI = #flatitem{arg = {var, _, _}}, [_|BoundVars]) ->
    is_variable(FI, BoundVars);
is_variable(#flatitem{arg = {var, _, _}}, []) ->
    true;
is_variable(_, _) ->
    false.

%% Function: split(FlatItems, BoundVars)
%% Purpose: splits a list of #flatitem{} records into two groups, and resolve them accordingly
%% Arguments:
%%   FlatItems::[#flatitem{}]
%%   BoundVars::[atom()] - list of bound variables
%% Returns:
%%   {Guards, Exprs}
%%     Exprs - all those flatitems, that assign a value to an unbound variable, converted to
%%             Erlang match expressions
%%     Guards - all those flatitems, that test the value of an expression (=the remaining ones). converted to 
%%              Erlang guard expressions
split([Item|Flats], BoundVars) ->
    {Guards, Exprs} = split(Flats, BoundVars),
    case is_variable(Item, BoundVars) of
        true ->
            {Guards, [resolve_path(Item, match)|Exprs]};
        _ ->
            {[resolve_path(Item, guard)|Guards], Exprs}
    end;
split([], _) ->
    {[], []}.

%% Function: extract_boundvars(FlatItems)
%% Purpose: list all the variables that get bound by a list of FlatItems
%% Arguments:
%%   FlatItems::[#flatitem{}]
%% Returns:
%%   [atom()] - the list of variable names
extract_boundvars([#flatitem{arg = {var,_,Var}}|L]) ->
    [Var|extract_boundvars(L)];
extract_boundvars([_|L]) ->
    extract_boundvars(L);
extract_boundvars([]) ->
    [].

%% Function: equalities(Exprs)
%% Purpose:
%%      Goes thorough a list of AST match expressions, and searches for variable
%%      duplications on the left hand sides of the matches. The right sides
%%      of these are taken, and equality checks created of them, and returned, in ASTs of guards.
%% Arguments:
%%      Exprs: a list of match expressions 
%%             by design, their left-hand sides are assumed to be variables FIXME: is this necessary?)
%% Returns:
%%      A list of ASTs of guard expressions, that check for equality all the right-hand sides of match
%%      expressions (from Exprs), whose left-hand sides were found to be equal.
equalities(Exprs) ->
    Exprs3 = lists:sort(fun({match, _, Arg1, _}, {match, _, Arg2, _}) ->
                Arg1 > Arg2
            end,
            Exprs),
    generate_equalities(Exprs3).
generate_equalities([]) ->
    [];
generate_equalities([_]) ->
    [];
generate_equalities([{match, Line, Arg, Expr1}, X = {match, _, Arg, Expr2}|L]) ->
    [{op, Line, '=:=', Expr1, Expr2}
     |generate_equalities([X|L])
    ]; 
generate_equalities([_|L]) ->
    generate_equalities(L).
